home *** CD-ROM | disk | FTP | other *** search
/ Interplay's Learn to Program Basic (Review Copy) / Learn to Program Basic Review Copy (Interplay)(June 23, 1998).ISO / pc / ltpbasic / projects / concentr.bas < prev    next >
Encoding:
BASIC Source File  |  1998-02-21  |  4.0 KB  |  216 lines
  1. Rem Concentration
  2. Rem The object of this game is
  3. Rem to match up all the faces
  4. Rem in the least possible tries.
  5.  
  6. Rem Declare the arrays, setup the sprite
  7. Dim faces(18)
  8. Dim grid(6,6)
  9. Dim remap(18)
  10. Rem This string names the
  11. Rem background to be used
  12. background$ = "cncntrtn"
  13. Rem Load the face sprites
  14. face = LoadSprite("Faces")
  15. Rem Load the sprites for 'star'
  16. star = LoadSprite("star")
  17. Rem The first image in the star
  18. Rem set is blank, the second is a star
  19. Rem to mark where we've been
  20. SetSprite star FRAME 0
  21.  
  22. Rem Define sounds to use
  23. clickFirstSnd = LoadSound("BLIP2")
  24. rightChoiceSnd = LoadSound("CASHREG")
  25. wrongChoiceSnd = LoadSound("CARHORN2")
  26. gameOverSound$ = "GAMOVER1"
  27.  
  28. Rem Don't show these sprites yet
  29. HideSprite face
  30. HideSprite star
  31.  
  32. continue = TRUE
  33. whiteout = FALSE
  34.  
  35. Rem Outer loop - continue playing the game
  36. Rem until the users wishes to stop
  37. while continue
  38. gosub SetupFaces
  39. Position 14,0
  40. guess = 0
  41. score = 0
  42. toggle = 0
  43. oldface = 0
  44. oldx = -1
  45. oldy = -1
  46. try = 0
  47.  
  48. Rem Main loop - continue choices
  49. Rem until the user got all of the squares
  50. go = 1
  51. while go
  52. if clickrect(0,0 to 319,239) then
  53. Rem If user click the mouse, find out which grid
  54. Rem square was clicked on
  55. xm = mousex
  56. ym = mousey
  57. xt = -1
  58. yt = -1
  59. for x = 1 to 6
  60. for y = 1 to 6
  61. Rem Each rectangle is spaced
  62. Rem 46 x 37 pixels apart
  63. x1 = 29+((x-1)*46)
  64. y1 = 6+((y-1)*37)
  65. Rem and each rectangle is 
  66. Rem 32 x 34 pixels
  67. x2 = x1 + 32
  68. y2 = y1 + 34
  69. if xm >= x1 and xm <= x2 and ym >= y1 and ym<=y2 then
  70. xt = x
  71. yt = y
  72. endif
  73. next y
  74. next x
  75.  
  76. if xt <> -1 then
  77. if grid(xt,yt) <> -1 then
  78. Rem User click in a grid square, paste a face to it
  79. x = xt
  80. y = yt
  81. pic = grid(xt,yt)
  82. Gosub PasteFace
  83.  
  84. Rem If this is the first one to be clicked on, set a flag
  85. if toggle = 0 then
  86. PlaySound(clickFirstSnd)
  87. toggle = 1
  88. oldface = grid(xt,yt)
  89. oldx = xt
  90. oldy = yt
  91. grid(xt,yt) = -1
  92. else
  93. Rem if this is the 2nd one, check for a match with the first
  94. try = try + 1
  95. toggle = 0
  96. grid(oldx, oldy) = oldface
  97. if grid(xt,yt) = oldface then
  98. Rem 2 matching faces!  Increase score
  99. PlaySound(rightChoiceSnd)
  100. grid(xt,yt) = -1
  101. grid(oldx, oldy) = -1
  102. score = score + 1
  103. if score = 18 then go = 0
  104. else
  105. Rem 2 different faces - blank both out and go on
  106. PlaySound(wrongChoiceSnd)
  107. sleep 10
  108. xsqr = oldx
  109. ysqr = oldy
  110. SetSprite star FRAME 1
  111. gosub FillSquare
  112. xsqr = xt
  113. ysqr = yt
  114. gosub FillSquare
  115. SetSprite star FRAME 0
  116. endif
  117. endif
  118. endif
  119. endif
  120. endif
  121. wend
  122.  
  123. Rem End game - prompt if they want to try again
  124. Rem If not, stop.
  125. Sound gameOverSound$
  126. color 190
  127. fillrect 0,200 to 260,239
  128. color 6
  129. position 0,13
  130. print "You got it in ";try;" tries."
  131. input "Try again (y/n)?",a$
  132. if lower$(left$(a$,1))="n" then continue = 0
  133. wend
  134. end
  135.  
  136. Rem Generate a random grid of 18 faces, and place
  137. Rem 2 of each onto the grids
  138. SetupFaces:
  139.  
  140. Rem Create a remap table for 18 different faces
  141. numFrames = GetSpriteNumFrames(face)
  142. Rem Sprite set MUST contain at least 18 images
  143. Rem or else we won't have enough to work with
  144. If numFrames < 18 Then
  145. CLS
  146. Print "The sprite set does not contain enough images!"
  147. Endif
  148. Rem Now, pick a random set of 18 from the images
  149. Rem and put them into our array
  150. For z = 1 to 18
  151. redoremap:
  152. remap(z) = random(0,numFrames-1)
  153. for ctr = 1 to z-1
  154. if remap(z) = remap(ctr) then goto redoremap
  155. next ctr
  156.  
  157. next z
  158.  
  159.  
  160. Rem set up the screen
  161. cls
  162. Background background$
  163.  
  164. Rem create the 6x6 grid
  165. for z= 1 to 18
  166. faces(z) = 0
  167. next z
  168.  
  169. for x = 1 to 6
  170. for y = 1 to 6
  171. loop:
  172. pic = random(1,18)
  173. if faces(pic) = 2 then goto loop
  174. faces(pic) = faces(pic) + 1
  175. grid(x,y) = pic
  176. xsqr = x
  177. ysqr = y
  178. gosub FillSquare
  179. next y
  180. next x
  181. return
  182.  
  183. Rem Put a sprite into the x,y specified grid square
  184. PasteFace:
  185. whiteout = TRUE
  186. xsqr = x
  187. ysqr = y
  188. gosub FillSquare
  189. SetSprite face frame remap(pic)
  190. SetSprite face to 29+((x-1)*46), 6+((y-1)*37)
  191. PasteSprite face
  192. SetSprite face to -100,-100
  193. return
  194.  
  195. Rem Clear the graphics from a specific square
  196. Rem If whiteout is 1, fill it with white,
  197. Rem Otherwise, mark it with a star
  198. FillSquare:
  199. x1 = 28+((xsqr-1)*46)
  200. y1 = 6+((ysqr-1)*37)
  201. If whiteout = TRUE then
  202. x2 = x1 + 32
  203. y2 = y1 + 31
  204. color 6
  205. FillRect x1,y1 to x2,y2
  206. whiteout = FALSE
  207. else
  208. SetSprite star to x1,y1
  209. ShowSprite star
  210. PasteSprite star
  211. HideSprite star
  212. endif
  213. return
  214.  
  215.